module Plane(bottom, TurnDirection(..), turnDirection, grahamScanSort,
             convexHull) where

import Data.List

bottom :: [(Int, Int)] -> (Int, Int)
bottom = minimumBy reverseLexicographicalCompare where
    reverseLexicographicalCompare (a,b) (c,d)
        | b < d = LT
        | b > d = GT
        | otherwise = compare a c

data TurnDirection = LeftTurn | RightTurn | Straight
                     deriving (Eq, Show)

turnDirection (x1, y1) (x2, y2) (x3, y3) =
    let (v1, w1) = (x2-x1, y2-y1)
        (v2, w2) = (x3-x2, y3-y2)
        det = v1 * w2 - w1 * v2
    in
      prodToTurn det where
          prodToTurn det | det > 0 = LeftTurn
          prodToTurn det | det < 0 = RightTurn
          prodToTurn 0 = Straight

compareTurn LeftTurn = LT
compareTurn RightTurn = GT
compareTurn Straight = EQ

grahamScanSort points =
    (first : (sortBy grahamScanOrdering (delete first points))) where
        first = bottom points
        grahamScanOrdering x y = compareTurn (turnDirection first x y)

-- This doesn't work if there are enough points in a row stretching
-- out from the first point - in that case, you only want to include
-- the outermost point on the line (at most), but, depending on the
-- order, you can end up including internal points as well.  You could
-- fix this by having a more refined notion of turnDirection or by
-- having grahamOrdering take into account the distance from the first
-- point when ordering collinear points.
convexHull points =
    reverse (removeRightTurns rest [second, first])  where
        (first:second:rest) = grahamScanSort points
        removeRightTurns [] result = result
        removeRightTurns (c:ps) (b:a:qs)
            | turnDirection a b c == RightTurn = removeRightTurns (c:ps) (a:qs)
            | otherwise = removeRightTurns ps (c:b:a:qs)
